home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Tools 3
/
Amiga Tools 3.iso
/
rexx
/
status.pvrx
< prev
next >
Wrap
Text File
|
1995-02-15
|
11KB
|
393 lines
/***************************************************************************
* *
* $VER: Status.pvrx 3.0 (11.Oct.93) *
* Copyright © 1993 by Stylus, Inc. *
* Author: Jeff Blume *
* *
* This macro reports the status of the current project or selected *
* object(s): *
* *
* Project Status: *
* 1. Num layers *
* 2. Num objs *
* 3. Total Points *
* 3b. Avg Number of Points - Not implemented *
* 5. Largest object with test against RIP limits. *
* 6. Magnification *
* 7. File Size *
* 8. Fonts USED - Not implemented *
* *
* Object Status: *
* 1. Attrs (Color names not implemented) *
* 2. Num. points *
* 3. Layer occupied *
* 4. Magnetism state *
* *
* *
***************************************************************************/
/*
address 'ProVector'
call open STDOUT,"RAM:RxOut.txt",W
call open STDERR,"RAM:RxErr.txt",W
trace R
*/
if ~show('Libraries','rexxsupport.library') then
call addlib('rexxsupport.library',0,-30,0)
options results
/* Try to get exclusive lock on project window.
If can't get lock, not polite to interrupt. */
'Lock Wait'
/* Initialize some variables */
TotalPolys = 0
TotalPts = 0
MaxObj = 0
TotalMisc = 0
/* Check for selected objs */
'SelectList' Sel; SelN = Result
if SelN ~= 0 then call StatusObj
else call StatusProj
'UnLock'
EXIT
STATUSPROJ:
'Prompt "Gathering Project Stats."'
/* Get list of Layer names */
'CurrentLayer'; CurLay = Result
'GetLayers' LayList; NumLay = Result
/* Loop through list of layers */
do k=0 for NumLay
/* Select all objs in layer */
'FirstObj' LayList.k
if Result = 0 then iterate k; else Objs.0 = Result
'TypeOf' Objs.0; ObjType = Result
select
when ObjType = "Polygon" | ObjType = "Polyline" then
do
TotalPolys = TotalPolys + 1
'GetPoints' Objs.0 ObjPts; NumPts=Result
if MaxObj < NumPts then do
MaxObj = NumPts
MaxObjPtr = Objs.0
end /* End If */
else NOP
TotalPts = TotalPts + NumPts
end
when ObjType ="Group" then
do
TotalMisc = TotalMisc + 1
call CountGroup Objs.0
end
otherwise TotalMisc = TotalMisc + 1
end
do i = 1
j = i - 1
'NextObj' Objs.j; Objs.i = result
if Objs.i = 0 then leave i
'TypeOf' Objs.i; ObjType = Result
select
when ObjType = "Polygon" | ObjType = "Polyline" then
do
TotalPolys = TotalPolys + 1
'GetPoints' Objs.i ObjPts; NumPts=Result
if MaxObj < NumPts then
do
MaxObj = NumPts
MaxObjPtr = Objs.i
end /* End If */
else NOP
TotalPts = TotalPts + NumPts
end
when ObjType ="Group" then
do
TotalMisc = TotalMisc + 1
call CountGroup Objs.i
end
otherwise TotalMisc = TotalMisc + 1
end /* end select */
end /* Obj list loop */
end /* NumLay loop */
call Magnification
call FileSize
call DefGads
'EndPrompt'
address REXXREQUEST 'GetRequest Gads'; OK = Result
call MaxObject
return
STATUSOBJ:
/* Getattrs, count points */
MaxObj = 0
do i = 0 to SelN-1
'Prompt "Gathering Object Stats."'
'GetAttrs' Sel.i Attrs
'LayerOf' Sel.i; LName = Result
'GetMagnets MagList'; NMags = Result
if NMags = 0 then Magnet = "OFF"
else
do m=0 for NMags
if Sel.i = MagList.m then
do
Magnet = "ON"
leave m
end
Magnet = "OFF"
end
'TypeOf' Sel.i; ObjType = Result
select
when ObjType = "Polygon" | ObjType = "Polyline" then
do
'GetPoints' Sel.i ObjPts; TotalPts=Result
Attrs.Font = "None"; Attrs.PointSize = "None"
end
/* Even better - restructure whole mess */
when ObjType = "Group" then
do
TotalMisc = TotalMisc + 1
call CountGroup Sel.i
end
otherwise TotalPts = "Object Not Poly"
end /* end select */
call DefGads
'EndPrompt'
address REXXREQUEST 'GetRequest Gads'; OK = Result
MaxObj = TotalPts
MaxObjPtr = Sel.i
call MaxObject
end /* end i (Selected) loop */
return
COUNTGROUP:
procedure expose TotalPolys TotalPts TotalMisc MaxObj MaxObjPtr
arg Grp
'GroupObj' Grp; GrpObj.0 = Result
'TypeOf' GrpObj.0; GrpType = Result
select
when GrpType = "Polygon" | ObjType = "Polyline" then
do
TotalPolys = TotalPolys + 1
'GetPoints' GrpObj.0 ObjPts; NumPts=Result
if MaxObj < NumPts then
do
MaxObj = NumPts
MaxObjPtr = GrpObj.0
end /* End If */
else NOP
TotalPts = TotalPts + NumPts
end
/* Recursion can't handle Nested Groups, need to save state of
loop first- shouldn't REXX do that for me - yes, when PROCEDURE ? */
when GrpType ="Group" then
do
TotalMisc = TotalMisc + 1
call CountGroup GrpObj.0
end
otherwise TotalMisc = TotalMisc + 1
end /* end select */
do g = 1
h = g - 1
'NextObj' GrpObj.h; GrpObj.g = Result
if GrpObj.g = 0 then leave g
'TypeOf' GrpObj.g; GrpType = Result
select
when GrpType = "Polygon" | ObjType = "Polyline" then
do
TotalPolys = TotalPolys + 1
'GetPoints' GrpObj.g ObjPts; NumPts=Result
if MaxObj < NumPts then
do
MaxObj = NumPts
MaxObjPtr = GrpObj.g
end /* End If */
else NOP
TotalPts = TotalPts + NumPts
end
when GrpType ="Group" then
do
TotalMisc = TotalMisc + 1
call CountGroup GrpObj.g
end
otherwise TotalMisc = TotalMisc + 1
end /* end select */
end
return
MAXOBJECT:
/* If MaxObj >= 1500 pts, it exceeds limit of many PostScript devices! */
/* Warn & offer to select obj */
if MaxObj = "Object Not Poly" then return
if MaxObj >= 1500 then
do
'GetBool "Obj exceeds older PostScript devices!" "Ok" "Select"'
if RC = 25 then 'SelectObj MaxObjPtr'
end
return
FILESIZE:
'GetCurrProj'; ProjPtr = Result
'ProjName ProjPtr'; FName = Result
FSize = word( statef(FName), 2)
return
MAGNIFICATION:
Mag = 1
/* Get the page width & height */
'GetPageDims' Dims /* Dims.Width;Dims.Height */
/* Get the current view */
'GetView' View /*View.X1;View.Y1;View.X2;View.Y2*/
/* View Width & Height */
W = View.X2-View.X1; H = View.Y2-View.Y1
if W >= H then Mag = Dims.Width/W
else Mag = Dims.Height/H
return
DEFGADS:
/* Define Public Screen */
Gads.PubScreen = "PROVECTOR"
if SelN ~=0 then call ObjReq
else call ProjReq
return
PROJREQ:
/* Define Window */
Gads.0.LeftEdge = 118; Gads.0.TopEdge = 59
Gads.0.Width = 352; Gads.0.Height = 94
Gads.0.Label = "Project Status"
/* Define Label Gadgets */
Gads.1.LeftEdge = 14; Gads.1.TopEdge = 8
Gads.1.Width = 112; Gads.1.Height = 12
Gads.1.Type = Label
Gads.1.Label = "Current Layer = "||CurLay
Gads.2.LeftEdge = 14; Gads.2.TopEdge = 16
Gads.2.Width = 112; Gads.2.Height = 12
Gads.2.Type = Label
Gads.2.Label = "Total Layers = "||NumLay
Gads.3.LeftEdge = 14; Gads.3.TopEdge = 24
Gads.3.Width = 112; Gads.3.Height = 12
Gads.3.Type = Label
Gads.3.Label = "Total Polygons = "||TotalPolys||" polygons,"
Gads.4.LeftEdge = 14; Gads.4.TopEdge = 32
Gads.4.Width = 112; Gads.4.Height = 12
Gads.4.Type = Label
Gads.4.Label = "Total Points = "||TotalPts||" points."
Gads.5.LeftEdge = 14; Gads.5.TopEdge = 40
Gads.5.Width = 112; Gads.5.Height = 12
Gads.5.Type = Label
Gads.5.Label = "Other Objs (Text, Groups, etc.) = "||TotalMisc
Gads.6.LeftEdge = 14; Gads.6.TopEdge = 48
Gads.6.Width = 112; Gads.6.Height = 12
Gads.6.Type = Label
Gads.6.Label = "Largest Object = "||MaxObj||" points."
Gads.7.LeftEdge = 14; Gads.7.TopEdge = 56
Gads.7.Width = 112; Gads.7.Height = 12
Gads.7.Type = Label
Gads.7.Label = "File Size = "||FSize||" bytes."
Gads.8.LeftEdge = 15; Gads.8.TopEdge = 64
Gads.8.Width = 112; Gads.8.Height = 12
Gads.8.Type = Label
Gads.8.Label = "Magnification = "||Mag||"x"
/* Total Gadgets + Window */
Gads.NumGads = 9
return /* return DefGads */
OBJREQ:
/* Define Window */
Gads.0.LeftEdge = 118; Gads.0.TopEdge = 59
Gads.0.Width = 272; Gads.0.Height = 114
Gads.0.Label = "Object Status"
/* Define Label Gadgets */
Gads.1.LeftEdge = 14; Gads.1.TopEdge = 8
Gads.1.Width = 112; Gads.1.Height = 12
Gads.1.Type = Label
Gads.1.Label = "Total Points = "||TotalPts
Gads.2.LeftEdge = 14; Gads.2.TopEdge = 16
Gads.2.Width = 112; Gads.2.Height = 12
Gads.2.Type = Label
Gads.2.Label = "Fill Type = "||Attrs.FillType
Gads.3.LeftEdge = 14; Gads.3.TopEdge = 24
Gads.3.Width = 112; Gads.3.Height = 12
Gads.3.Type = Label
Gads.3.Label = "Fill Value = "||Attrs.FillVal
Gads.4.LeftEdge = 14; Gads.4.TopEdge = 32
Gads.4.Width = 112; Gads.4.Height = 12
Gads.4.Type = Label
Gads.4.Label = "Line Type = "||Attrs.EdgeType
Gads.5.LeftEdge = 14; Gads.5.TopEdge = 40
Gads.5.Width = 112; Gads.5.Height = 12
Gads.5.Type = Label
Gads.5.Label = "Line Value = "||Attrs.EdgeVal
Gads.6.LeftEdge = 14; Gads.6.TopEdge = 48
Gads.6.Width = 112; Gads.6.Height = 12
Gads.6.Type = Label
Gads.6.Label = "Line Weight = "||Attrs.EdgeWidth
Gads.7.LeftEdge = 14; Gads.7.TopEdge = 56
Gads.7.Width = 112; Gads.7.Height = 12
Gads.7.Type = Label
Gads.7.Label = "Line Join = "||Attrs.LineJoin
Gads.8.LeftEdge = 14; Gads.8.TopEdge = 64
Gads.8.Width = 112; Gads.8.Height = 12
Gads.8.Type = Label
Gads.8.Label = "Font = "||Attrs.Font
Gads.9.LeftEdge = 14; Gads.9.TopEdge = 72
Gads.9.Width = 112; Gads.9.Height = 12
Gads.9.Type = Label
Gads.9.Label = "Point Size = "||Attrs.PointSize
Gads.10.LeftEdge = 15; Gads.10.TopEdge = 80
Gads.10.Width = 112; Gads.10.Height = 12
Gads.10.Type = Label
Gads.10.Label = "Magnetism = "||Magnet
Gads.11.LeftEdge = 14; Gads.11.TopEdge = 88
Gads.11.Width = 112; Gads.11.Height = 12
Gads.11.Type = Label
Gads.11.Label = "Layer = "||LName
/* Total Gadgets + Window */
Gads.NumGads = 12
return /* return ObjReq */
/*
address command "'list >PIPE:FSize HD3:PV/DR2D_Drawings/"||FName||" LFormat=%L'"
/* Above should have worked, but instead passed "'list" as the command */
/* Below worked */
address command list ">PIPE:FSize HD3:PV/DR2D_Drawings/"||FName||" LFormat=%L"
*/